home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v9n03.arc / PIANO.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-12  |  6KB  |  190 lines

  1.  
  2. PIANO.PAS
  3.  
  4.  
  5.  
  6. PROGRAM Piano;
  7. USES CRT;
  8.  
  9. VAR
  10.   vari : Integer;
  11.   test, dly, intern, dlykeep : LongInt;
  12.   flager, chartoplay : Char;
  13.   numb, octave : Integer;
  14.   typom, min1, adder : Real;
  15.  
  16.   PROCEDURE Play(SoundC : STRING);
  17.     FUNCTION IsNumber(ch : CHAR) : Boolean;
  18.     BEGIN
  19.       IsNumber := (CH >= '0') AND (CH <= '9');
  20.     END;
  21.  
  22.     FUNCTION value(s : STRING) : Integer;
  23.       {Converts a string to an integer}
  24.     VAR ss, sss : Integer;
  25.     BEGIN
  26.       Val(s, ss, sss);
  27.       value := ss;
  28.     END;
  29.  
  30.     PROCEDURE sounder(key : Char; flag : Char);
  31.       {Plays the selected note}
  32.     VAR
  33.       old, New, new2 : Real;
  34.     BEGIN
  35.       adder := 1;
  36.       old := dly; New := dly;
  37.       intern := Pos(key, 'C D EF G A B')-1;
  38.       IF (flag = '+') AND (key <> 'E') AND (key <> 'B') {See if note}
  39.       THEN Inc(intern);                                 {is sharped }
  40.       IF (flag = '-') AND (key <> 'F') AND (key <> 'C')
  41.       THEN Dec(intern);                                 {or a flat. }
  42.       WHILE SoundC[vari+1] = '.' DO
  43.         BEGIN
  44.           Inc(vari);
  45.           adder := adder/2;
  46.           New := New+(old*adder);
  47.         END;
  48.       new2 := (New/typom)*(1-typom);
  49.       sound(Round(Exp((octave+intern/12)*Ln(2)))); {Play the note}
  50.       Delay(Trunc(New));
  51.       Nosound;
  52.       Delay(Trunc(new2));
  53.     END;
  54.  
  55.     FUNCTION delayer1 : Integer;
  56.       {Calculate delay for a specified note length}
  57.     BEGIN
  58.       numb := value(SoundC[vari+1]);
  59.       delayer1 := Trunc((60000/(numb*min1))*typom);
  60.     END;
  61.  
  62.     FUNCTION delayer2 : Integer;
  63.       {Used as above, except reads a number >10}
  64.     BEGIN
  65.       numb := value(SoundC[vari+1]+SoundC[vari+2]);
  66.       delayer2 := Trunc((60000/(numb*min1))*typom);
  67.     END;
  68.  
  69.   BEGIN                           {Play}
  70.     SoundC := SoundC+' ';
  71.     FOR vari := 1 TO Length(SoundC) DO
  72.       BEGIN                       {Go through entire string}
  73.         SoundC[vari] := Upcase(SoundC[vari]);
  74.         {^Get a char and convert to CAPS}
  75.         CASE SoundC[vari] OF
  76.           'C','D','E','F','G','A','B' : BEGIN
  77.               {^Check to see if char is a note}
  78.               flager := ' '; dlykeep := dly;
  79.               chartoplay := SoundC[vari];
  80.               IF (SoundC[vari+1] = '-') OR (SoundC[vari+1] = '+')
  81.               THEN
  82.                 BEGIN {Check for flats & sharps}
  83.                   flager := SoundC[vari+1];
  84.                   Inc(vari);
  85.                 END;
  86.               IF IsNumber(SoundC[vari+1]) THEN
  87.                 BEGIN
  88.                   IF IsNumber(SoundC[vari+2]) THEN
  89.                     BEGIN
  90.                       test := delayer2;
  91.                       IF numb < 65 THEN dly := test; {Make sure # is legal}
  92.                       Inc(vari, 2);
  93.                     END
  94.                   ELSE
  95.                     BEGIN
  96.                       test := delayer1;
  97.                       IF numb > 0 THEN dly := test; {Make sure # is legal}
  98.                       Inc(vari);
  99.                     END;
  100.                 END;
  101.               sounder(chartoplay, flager);
  102.               dly := dlykeep;
  103.             END;
  104.  
  105.           'O' : BEGIN             {Check for octave change}
  106.               Inc(vari);
  107.               CASE SoundC[vari] OF
  108.                 '-' : IF octave > 1 THEN Dec(octave);
  109.                 '+' : IF octave < 7 THEN Inc(octave);
  110.                 '1','2','3','4','5','6','7' : octave := value(SoundC[vari])+4;
  111.               ELSE Dec(vari);
  112.               END;
  113.             END;
  114.  
  115.           {Check for a change in length for notes}
  116.           'L' : IF IsNumber(SoundC[vari+1]) THEN
  117.             BEGIN
  118.               IF IsNumber(SoundC[vari+2]) THEN
  119.                 BEGIN
  120.                   test := delayer2;
  121.                   IF numb < 65 THEN dly := test; {Make sure # is legal}
  122.                   Inc(vari, 2);
  123.                 END
  124.               ELSE
  125.                 BEGIN
  126.                   test := delayer1;
  127.                   IF numb > 0 THEN dly := test; {Make sure # is legal}
  128.                   Inc(vari);
  129.                 END;
  130.             END;
  131.  
  132.           {Check for a pause and it's length}
  133.           'P' : IF IsNumber(SoundC[vari+1]) THEN
  134.             BEGIN
  135.               IF IsNumber(SoundC[vari+2]) THEN
  136.                 BEGIN
  137.                   test := delayer2;
  138.                   IF numb < 65 THEN Delay(test); {Make sure # is legal}
  139.                   Inc(vari, 2);
  140.                 END
  141.               ELSE
  142.                 BEGIN
  143.                   test := delayer1;
  144.                   IF numb > 0 THEN Delay(test); {Make sure # is legal}
  145.                   Inc(vari);
  146.                 END;
  147.             END;
  148.  
  149.           {Check for tempo change}
  150.           'T' : IF IsNumber(SoundC[vari+1]) AND IsNumber(SoundC[vari+2]) THEN
  151.             BEGIN
  152.               IF IsNumber(SoundC[vari+3]) THEN
  153.                 BEGIN
  154.                   min1 := value(SoundC[vari+1]+SoundC[vari+2]+SoundC[vari+3]);
  155.                   Inc(vari, 3);
  156.                   IF min1 > 255 THEN min1 := 255; {Make sure # isn't too big}
  157.                 END
  158.               ELSE
  159.                 BEGIN
  160.                   min1 := value(SoundC[vari+1]+SoundC[vari+2]);
  161.                   IF min1 < 32 THEN min1 := 32; {Make sure # isn't too short}
  162.                 END;
  163.               min1 := min1/4;
  164.             END;
  165.  
  166.           {Check for music type}
  167.           'M' : BEGIN             
  168.               Inc(vari);
  169.               CASE Upcase(SoundC[vari]) OF
  170.                 'N' : typom := 7/8; {Normal}
  171.                 'L' : typom := 1; {Legato}
  172.                 'S' : typom := 3/4; {Staccato}
  173.               END;
  174.             END;
  175.         END;
  176.       END;
  177.   END;
  178.  
  179. BEGIN                             {Play Jingle Bells}
  180.   Play('T255MNO5L4');
  181.   Play('CAGFC2.P4C8C8CAGFD2.P4DB-AGE2.P4O6CCO5B-GA2.P4CAGFC2.');
  182.   Play('P4CAGFD2P4DDB-AGO6CCCCDCO5B-GF2O6C2O5');
  183.   Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
  184.   Play('AGGAG2O6C2O5');
  185.   Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
  186.   Play('O6CCO5B-GF2.');
  187. END.                              {PIANO}
  188.  
  189.  
  190.